perm filename OC.COM[MF,ALS] blob sn#769356 filedate 1984-09-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002			Comparison between MFDOVR and GFDOVER headers
C00008 00003			Comparison between MFDOVR and GFDOVER headers (continued)
C00016 ENDMK
C⊗;
		Comparison between MFDOVR and GFDOVER headers
For oc files

	ok
oc_halfword(4108); {header for family-name IX}
    Wout(doveroc,IX(1,12)) # header for family-name IX;
    define IX(typ, lngth)=⊂((typ lsh 12)+lngth)⊃;

	ok
oc_halfword(0); {name code}
    Wout(doveroc,0) # name code;

***	I do not know where to get this
oc_word(0); {|oc_string(fontidentifier,20);| goes in here, replacing 5 words}
oc_word(0);
oc_word(0);
oc_word(0);
oc_word(0);
    BCPLout(doveroc,fontidentifier,20);

	ok
oc_halfword(20491); {header for orbit-chars IX}
    Wout(doveroc,IX(5,11)) # header for orbit-chars IX;

	ok
oc_byte(0); {name code again}
    Bout(doveroc,0) # name code again;

**	May be ok now
    r←(design_size div 16) div unity;
       font_face_byte←254-2*r;
oc_byte(font_face_byte); {logical size encoded as font face byte}
    Bout(doveroc,fontfacebyte) # logical size encoded as face byte;

	ok
oc_byte(bc); {charcode for the first glyph}
    Bout(doveroc,bc);

	ok
oc_byte(ec); {charcode for the last glyph}
    Bout(doveroc,ec);


****	This is seriously in question
	We seem to get the wrong point size and wrong mica size
		point size = 624  mica size = 22016
		xresolution 204
    @p function phys_size(i:integer):integer;
    var r: real;
    begin
    r←(i*magnification*2540/ppi);
    phys_size←round(r);
    end;
oc_halfword(phys_size(design_size)); {physical size in micas}
    Wout(doveroc,(designsize*magnification*2540/ppi)) # physical siz in micas;

	ok
oc_halfword(0); {rotation in minutes of arc}
    Wout(doveroc,(60*rotation)+0.5) # rotation in minutes of arc;

	ok
oc_word(char_seg_file_pos); {starting file pos of font segment in halfwords}
    Dout(doveroc,fontsegstart) # starting file pos of font segment;

	ok
oc_word(wd_byte_no div 2); {font segment length in half words}
    Dout(doveroc,fontsegend-fontsegstart) # and font segment length;

** This may possibly be wrong
pix_res←round(3840/magnification+0.5);
oc_halfword(pix_res);
    Wout(doveroc,(xresolution*ppi*10/magnification)+0.5) # X resolution in
		    units of pixels/(10 inches);

** ditto with above
oc_halfword(pix_res);
    Wout(doveroc,(yresolution*ppi*10/magnification)+0.5) # Y resolution in
		    units of pixels/(10 inches);

	ok
oc_halfword(1); {endIX}
    Wout(doveroc,IX(0,1)) # endIX;

	probably ok
while oc_byte_no<2*seg_start do oc_halfword(0); 
    for i←1 thru (fontsegstart-'30) div 2 do DoutAligned(doveroc,0);

*****	Most certainly wrong
    while c≤ec do 
      begin
      if glyph_ptr[c]≠-1 then
	begin
    oc_word(tfm_width[c]);
	if not vectorwidths then
		begin
		charwx←charwd;
		charwy←0.0;
		end;
	CharWidthX[charcode]←charwx;
	    for c←bc thru ec do
		    if charsegptr[c]≠-1 then
			    begin
			    comment Convert the spacing Xwidth of the character
			      from points into (fixed.fraction) pixels;
	CharWidthY[charcode]←charwy;
		newwidth←(CharWidthX[c]*xresolution*(2↑16))+0.5;
		Dout(doveroc,newwidth);


** probably ok but question
    oc_word(0);  {assuming not vectorwidths}
		newwidth←(CharWidthY[c]*yresolution*(2↑16))+0.5;
		Dout(doveroc,newwidth);

	ok
oc_halfword(min_x_array[c]);
	Wout(doveroc,BBoxArray[c]);


	ok
oc_halfword(min_y_array[c]);
	Wout(doveroc,BBoyArray[c]);

	ok
oc_halfword(glyph_cols[c]);
	Wout(doveroc,BBdyArray[c]);

	ok
oc_halfword(glyph_rows[c]);
	Wout(doveroc,BBdxArray[c]);

	probably ok
    else
    begin
    i←1;
    while i≤7 do
      begin
      oc_halfword(0);
      incr(i);
      end;
    oc_halfword(-1);
    end;
	  else	begin
		integer i;
		for i←1 thru 7 do Wout(doveroc,0);
		Wout(doveroc,-1) # marks a non-existent character;
		end;
		Comparison between MFDOVR and GFDOVER headers (continued)
For wd files

	ok
wd_halfword(4108); {header for family-name IX}
    Wout(presswd,IX(1,12)) # header for family-name IX;

	ok
wd_halfword(0); {name code}
Wout(presswd,0) # name code;

***	I do not know where to get this
wd_word(0); {|wd_string(fontidentifier,20);| goes in here, replacing 5 words}
wd_word(0);
wd_word(0);
wd_word(0);
wd_word(0);
    BCPLout(presswd,fontidentifier,20);

	ok
wd_halfword(20491); {header for orbit-chars IX}
    Wout(presswd,IX(4,9)) # header for orbit-chars IX;

	ok
wd_byte(0); {name code again}
    Bout(presswd,0) # name code again;

**	May be ok now
    r←(design_size div 16) div unity;
       font_face_byte←254-2*r;
wd_byte(font_face_byte); {logical size encoded as font face byte}
    Bout(presswd,fontfacebyte) # logical size encoded as face byte;


	ok
wd_byte(bc); {charcode for the first glyph}
    Bout(presswd,bc);

	ok
wd_byte(ec); {charcode for the last glyph}
    Bout(presswd,ec);

	ok
wd_halfword(0);
    Wout(presswd,0) # physical size field: 0 means scalable;

	ok
wd_halfword(0); {rotation in minutes of arc}
    Wout(presswd,(60*rotation)+0.5) # rotation in minutes of arc;

	ok
wd_word(22); {starting file pos of font segment in halfwords}
    Dout(presswd,22) # starting file pos of font segment (right after endIX);

	ok
if fixed_x then wd_word(7) else wd_word(nc+6); {data segment length in half words}
    Dout(presswd,wdlen) # length of data segment;

	ok
wd_halfword(1); {endIX}
    Wout(presswd,IX(0,1)) # endIX;

	probably ok
@p procedure wd_real(r:real);
var int:integer;
begin
int←round((r*1000/design_size)+0.5);
if abs(int)>32766 then error('value exceeds bounds of .wd format!');
wd_halfword(int);
end;
      procedure RealWout(real r) # scale and output one numeric value;
	    begin integer int;
	    int←((r*1000/designsize) + 0.5);
	    if abs(int)≥(2↑15-1) then
	     error("Distance of "&cvf(r)&" points exceeds bounds of .WD format.");
	    Wout(presswd,int);
	    end;
		fbbox←bbxlmin/xresolution;
		fbboy←bbylmin/yresolution;
		fbbdx←(bbxrmax-bbxlmin+1)/xresolution;
		fbbdy←(bbyhmax-bbylmin+1)/yresolution;

	probably ok
wd_real(min_x_overall/xresolution); {x offset of font bounding box}
    RealWout(fbbox) # X offset of font bounding box;

	probably ok
wd_real(min_y_overall/yresolution); {y offset of font bounding box}
    RealWout(fbboy) # Y offset of font bounding box;

	probably ok
wd_real(cols_max/xresolution); {x dimension of font bounding box}
    RealWout(fbbdx) # X dimension of font bounding box;

	probably ok
wd_real(rows_max/yresolution); {y dimension of font bounding box}
    RealWout(fbbdy) # Y dimension of font bounding box;

*** probably ok even if units are wrong  
if tfm_min=tfm_max then fixed_x←true else fixed_x←false; {fixed-y is true always}
if fixed_x then wd_byte(192) else wd_byte(64); {fixed flags}
wd_byte(0); {flags are actually stored in a half word, this fills it out}
    Wout(presswd,(if fixedx then 1 lsh 15 else 0)+
		(if fixedy then 1 lsh 14 else 0)) # fixedflags;

****  The first branch does not apply for BASK but it is probably wrong
if fixed_x then wd_halfword(tfm_max)
  else
  begin
  c←bc;
  while c≤ec do
    begin
    if glyph_ptr[c]=-1 then 
      begin wd_byte(128);wd_byte(0);
      end
***    else wd_halfword(tfm_width[c]);  { *** this needs verification *** }
    incr(c);
    end;
  end;
wd_halfword(0);
if wd_byte_no≠56+2*nc then 
  begin print_nl; print(wd_byte_no); print(' instead of ',56+2*nc:1);
  end;

	saf real array CharWidthX[0:'177];
	saf real array CharWidthY[0:'177] # x and y components of
		the vector widths of characters;
	    CharWidthX[charcode]←charwx;
	    CharWidthY[charcode]←charwy;
	    define charwx=⊂realparam[24]⊃ # x component of vector width; 
	    define charwy=⊂realparam[25]⊃ # y component of vector width; 

NOTE: charwx being real and stored in a halfword seems to imply that it is
already of the dimensions of the |w| in |char_loc| and that |w| should not
be multiplied by 1000/designsize.


    if fixedx then RealWout(charwxmax) 
     else for c←bc thru ec do
	    if CharWidthX[c]=nonexistentcharflag then
		    Wout(presswd,1 lsh 15)
	    else RealWout(CharWidthX[c]);

    if fixedy then RealWout(charwymax) 
     else for c←bc thru ec do
	    if CharWidthX[c]=nonexistentcharflag then
		    Wout(presswd,1 lsh 15)
	    else RealWout(CharWidthY[c]);
    end;

	ok
if (wd_byte_no mod 4)≠0 then wd_halfword(0);
    if (bytecount[presswd] mod 4)≠0 then
	    Wout(presswd, 0) # pad to 32-bit-word boundary